home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / mouslib6.zip / MOUSELIB.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-01  |  34KB  |  900 lines
  1. (******************************************************************************
  2. *                                  MouseLib                                   *
  3. * Release 6.0 - Added demo program - Please refer to MOUSETST.PAS to                       *
  4. * see a demo of the mouseLib unit usage.                                                                             *
  5. ******************************************************************************)
  6. unit MouseLib;
  7.  
  8. interface
  9.  
  10. uses 
  11.     dos
  12.     ;
  13.  
  14. const
  15.     MOUSEINT = $33; {mouse driver interrupt}
  16.     LEFTBUTTON = 1; {bit 0}
  17.     RIGHTBUTTON = 2; {bit 1}
  18.     MIDDLEBUTTON = 4; {bit 2}
  19.  
  20.     CURSOR_LOCATION_CHANGED = 1; {event mask bits}
  21.     LEFT_BUTTON_PRESSED = 2;
  22.     LEFT_BUTTON_RELEASED = 4;
  23.     RIGHT_BUTTON_PRESSED = 8;
  24.     RIGHT_BUTTON_RELEASED = 16;
  25.     MIDDLE_BUTTON_PRESSED = 32;
  26.     MIDDLE_BUTTON_RELEASED = 64;
  27.  
  28. type
  29.     mouseType = (twoButton,threeButton,another);
  30.     buttonState = (buttonDown,buttonUp);
  31.     direction = (moveRight,moveLeft,moveUp,moveDown,noMove);
  32.     grCursorType = record
  33.         xH,yH : byte; {x,y Hot Point}
  34.         data  : pointer;  {cursor look pointer}
  35.     end;
  36. var
  37.     mouse_present : boolean;
  38.     mouse_buttons : mouseType;
  39.     eventX,eventY,eventButtons : word; {any event handler should update}
  40.     eventhappened : Boolean;       {these vars to use getLastEvent }
  41.     XMotions,YMotions : word;       {per 8 pixels}
  42.     mouseCursorLevel : integer;
  43.  
  44.     {if > 0 mouse cursor is visiable, otherwise not, containes the level
  45.      of showMouseCursor/hideMouseCursor}
  46.  
  47. const    LastMask : word = 0;
  48.     lastHandler : pointer = Nil;
  49.  
  50.     {when changing the interrupt handler temporarily, save BEFORE the
  51.         change these to variables, and restore them when neccessary}
  52.  
  53.     lastCursor : grCursorType = (
  54.         xH : 0;
  55.         yH : 0;
  56.         data : nil );
  57.  
  58.     {when changing graphic cursor temporarily, save these values BEFORE
  59.         the change, and restore when neccessary}
  60.  
  61. const
  62.     click_repeat  = 10; { Recommended value for waitForRelease timeOut }
  63.  
  64. procedure initMouse; {when replacing mouse mode do that..!}
  65. procedure showMouseCursor;
  66. procedure hideMouseCursor;
  67. function getMouseX : word;
  68. function getMouseY : word;
  69. function getButton(Button : Byte) : buttonState;
  70. function buttonPressed : boolean;
  71. procedure setMouseCursor(x,y : word);
  72. function LastXPress(Button : Byte) : word;
  73. function LastYPress(Button : Byte) : word;
  74. function ButtonPresses(Button : Byte) : word; {from last last check}
  75. function LastXRelease(Button : Byte) : word;
  76. function LastYRelease(Button : Byte) : word;
  77. function ButtonReleases(Button : Byte) : word; {from last last check}
  78. procedure mouseBox(left,top,right,bottom : word); {limit mouse rectangle}
  79. procedure graphicMouseCursor(xHotPoint,yHotPoint : byte; dataOfs : pointer);
  80. procedure HardwareTextCursor(fromLine,toLine : byte);
  81. procedure softwareTextCursor(screenMask,cursorMask : word);
  82. function recentXmovement : direction;
  83. function recentYmovement : direction;
  84. procedure setArrowCursor;
  85. procedure setWatchCursor;
  86. procedure setUpArrowCursor;
  87. procedure setLeftArrowCursor;
  88. procedure setCheckMarkCursor;
  89. procedure setPointingHandCursor;
  90. procedure setDiagonalCrossCursor;
  91. procedure setRectangularCrossCursor;
  92. procedure setHourGlassCursor;
  93. procedure setNewWatchCursor;
  94. procedure setEventHandler(mask : word; handler    : pointer);
  95. procedure setDefaultHandler(mask : word);
  96. procedure enableLightPenEmulation;
  97. procedure disableLightPenEmulation;
  98. procedure defineSensetivity(x,y : word);
  99. procedure setHideCursorBox(left,top,right,bottom : word);
  100. procedure defineDoubleSpeedTreshHold(treshHold : word);
  101. procedure disableTreshHold;
  102. procedure defaultTreshHold;
  103. procedure setMouseGraph;
  104. procedure resetMouseGraph;
  105. procedure waitForRelease(timeOut : word);
  106. procedure swapEventHandler(mask : word; handler : pointer); 
  107. { return old in lastMask and lastHandler }
  108. function getMouseSaveStateSize : word;
  109. procedure interceptMouse; { get mouse from interrupted program, and stop it .. }
  110. procedure restoreMouse;
  111.  
  112. (******************************************************************************
  113. *                                  MouseLib                                   *
  114. *                                                                             *
  115. *                        mouseLib     -      Release 2    and above                  *
  116. *                                                                                                 *
  117. *  because of quirks in hercules graphic mode that is not detectab            *
  118. *   by the mouse driver we have to know when we initMouse if we wa            *
  119. *   to check for graphic mode or not, if we do we must perform a                 *
  120. *   setMouseGraph before initGraph, to initGraph in text mode we m            *
  121. *   resetMouseGraph before.. , if these calling conventions are no            *
  122. *   taken we might have problems in hercules cards!                                 *
  123. *                                                                             *
  124. *  each call to hideMouseCursor must be balanced by a matching call           *
  125. *   to showMouseCursor, 2 calls to hideMou.. and only 1 to showM..             *
  126. *   will not show the mouse cursor on the screen!                                    *
  127. ******************************************************************************)
  128.  
  129. implementation
  130.  
  131. const watchData : array [0..31] of word =
  132.     ($E007,$C003,$8001,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$8001,$C003,$E007,
  133.      $0,$1FF8,$318C,$6186,$4012,$4022,$4042,$718C,$718C,$4062,$4032,
  134.      $4002,$6186,$318C,$1FF8,$0);
  135.  
  136. const arrowData : array [0..31] of word =
  137.     ($FFFF,$8FFF,$8FFF,$87FF,$83FF,$81FF,$80FF,$807F,$803F,$801F,$800F,
  138.      $801F,$807F,$887F,$DC3F,$FC3F,
  139.      $0,$0,$2000,$3000,$3800,$3C00,$3E00,$3F00,$3F80,$3FC0,
  140.      $3FE0,$3E00,$3300,$2300,$0180,$0180);
  141.  
  142. const UpArrowCursor : array [0..31] of word =
  143.          ($f9ff,$f0ff,$e07f,$e07f,$c03f,$c03f,$801f,$801f,
  144.           $f,$f,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,
  145.           $0,$600,$f00,$f00,$1f80,$1f80,$3fc0,$3fc0,
  146.           $7fe0,$600, $600, $600, $600, $600, $600, $600);
  147.  
  148. const  LeftArrowCursor : array [0..31] of word
  149.        = ($fe1f,$f01f,$0,   $0,   $0,   $f01f,$fe1f,$ffff,
  150.           $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  151.           $0,   $c0,  $7c0, $7ffe,$7c0, $c0,  $0,   $0,
  152.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  153.  
  154. const  CheckMarkCursor : array [0..31] of word
  155.        = ($fff0,$ffe0,$ffc0,$ff81,$ff03,$607, $f,   $1f,
  156.           $c03f,$f07f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  157.           $0,   $6,   $c,   $18,  $30,  $60,  $70c0,$1d80,
  158.           $700, $0,   $0,   $0,   $0,   $0,   $0,   $0);
  159.  
  160. const  PointingHandCursor : array [0..31] of word
  161.        = ($e1ff,$e1ff,$e1ff,$e1ff,$e1ff,$e000,$e000,$e000,
  162.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0,
  163.           $1e00,$1200,$1200,$1200,$1200,$13ff,$1249,$1249,
  164.           $f249,$9001,$9001,$9001,$8001,$8001,$8001,$ffff);
  165.  
  166. const  DiagonalcrossCursor : array [0..31] of word
  167.        = ($7e0, $180, $0,   $c003,$f00f,$c003,$0,   $180,
  168.           $7e0, $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  169.           $0,   $700e,$1c38,$660, $3c0, $660, $1c38,$700e,
  170.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  171.  
  172. const  RectangularCrossCursor : array [0..31] of word
  173.        = ($fc3f,$fc3f,$fc3f,$0,$0,   $0,   $fc3f,$fc3f,
  174.           $fc3f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  175.           $0,   $180, $180, $180, $7ffe,$180, $180, $180,
  176.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  177.  
  178. const  HourglassCursor : array [0..31] of word
  179.        = ($0,   $0,   $0,   $0,   $8001,$c003,$e007,$f00f,
  180.           $e007,$c003,$8001,$0,   $0,   $0,   $0,   $ffff,
  181.           $0,   $7ffe,$6006,$300c,$1818,$c30, $660, $3c0,
  182.           $660, $c30, $1998,$33cc,$67e6,$7ffe,$0,   $0);
  183.  
  184. const newWatchCursor : array [0..31] of word
  185.        = ( $ffff, $c003, $8001, $0, $0, $0, $0, $0, $0, 
  186.            $0, $0, $0, $0, $8001, $c003, $ffff, $0, $0, 
  187.            $1ff8, $2004, $4992, $4022, $4042, $518a, $4782, 
  188.            $4002, $4992, $4002, $2004, $1ff8, $0, $0 );
  189.        
  190.  
  191. const mouseGraph : boolean = False; {assume text mode upon entry}
  192.  
  193. type box = record
  194.         left,top,right,bottom : word;
  195.     end; {Do not change field order !!!}
  196.  
  197. var 
  198.    hideBox : box;
  199.    reg : registers;  {general registers used}
  200.    grMode,
  201.    grDrv : integer; {detect graphic mode if any}
  202.    grCode : integer;     {return initgraph code in here}
  203.    interceptX, 
  204.    interceptY : word;
  205.  
  206. (******************************************************************************
  207. *                                  callMouse                                  *
  208. *                                                                             *
  209. * used to call mouse interrupt with global data reg - used as parameters      *
  210. ******************************************************************************)
  211. procedure callMouse;
  212. begin
  213.         intr(MOUSEINT,REG);
  214. end; {callMouse}
  215.  
  216. (******************************************************************************
  217. *                                  initMouse                                  *
  218. * For some reason grCode is assigned a value of -11,($FFF5) in the second time*
  219. *  we call initmouse after we allready are in graphics mode, override.. was   *
  220. *  born because of that situation.                                            *
  221. ******************************************************************************)
  222. procedure initMouse;
  223. var
  224.     overRideDriver : boolean; { true if we over-ridden stupid driver hercules bug }
  225. begin
  226.     overRideDriver := false;
  227.     if (mouseGraph and (mem[0:$449] = 7)) then begin { assume no mda - hercules }
  228.       mem[0:$449] := 6;
  229.       overRideDriver := true;
  230.     end;
  231.       {trick stupid mouse driver to know we are in graphic mode}
  232.     with reg do begin
  233.         ax:=0; {detect genius mouse}
  234.         bx:=0; {be sure what mode we get}
  235.         callMouse;
  236.         mouse_present := (ax <> 0); {not an iret..}
  237.         if ((bx and 2) <> 0)
  238.             then mouse_buttons := twoButton
  239.         else if ((bx and 3) <> 0)
  240.             then mouse_buttons := threeButton
  241.         else mouse_buttons := another; {unknown to us}
  242.     end; {with}
  243.     if (overRideDriver) then
  244.       mem[0:$449] := 7;
  245.       {restore the stupid situation}
  246.        eventX := 0;
  247.        eventButtons := 0;
  248.        eventY := 0;
  249.        eventhappened := False;
  250.        XMotions := 8;
  251.        YMotions := 16;
  252.        mouseCursorLevel := 0; { not visiable, one show to appear }
  253. end; {initMouse}
  254.  
  255. (******************************************************************************
  256. *                               showMouseCursor                               *
  257. ******************************************************************************)
  258. procedure showMouseCursor;
  259.  
  260. begin
  261.     reg.ax:=1; {enable cursor display}
  262.     callMouse;
  263.     inc(mouseCursorLevel);
  264. end; {showMouseCursor}
  265.  
  266. (******************************************************************************
  267. *                               hideMouseCursor                               *
  268. ******************************************************************************)
  269. procedure hideMouseCursor;
  270.  
  271. begin
  272.     reg.ax:=2; {disable cursor display}
  273.     callMouse;
  274.     dec(mouseCursorLevel);
  275. end; {hideMouseCursor}
  276.  
  277. (******************************************************************************
  278. *                                  getMouseX                                  *
  279. ******************************************************************************)
  280. function getMouseX : word;
  281.  
  282. begin
  283.     reg.ax := 3;
  284.     callMouse;
  285.     getMouseX := reg.cx;
  286. end; {getMouseX}
  287.  
  288. (******************************************************************************
  289. *                                  getMouseY                                  *
  290. ******************************************************************************)
  291. function getMouseY : word;
  292.  
  293. begin
  294.     reg.ax := 3;
  295.     callMouse;
  296.     getMouseY := reg.dx;
  297. end; {getMouseX}
  298.  
  299. (******************************************************************************
  300. *                                  getButton                                  *
  301. ******************************************************************************)
  302. function getButton(Button : Byte) : buttonState;
  303.  
  304. begin
  305.     reg.ax := 3;
  306.     callMouse;
  307.     if ((reg.bx and Button) <> 0) then
  308.         getButton := buttonDown
  309.         {bit 0 = left, 1 = right, 2 = middle}
  310.     else getButton := buttonUp;
  311. end; {getButton}
  312.  
  313. (******************************************************************************
  314. *                                buttonPressed                                *
  315. ******************************************************************************)
  316. function buttonPressed : boolean;
  317.  
  318. begin
  319.     reg.ax := 3;
  320.     callMouse;
  321.     if ((reg.bx and 7) <> 0) then
  322.         buttonPressed := True
  323.     else buttonPressed := False;
  324. end; {buttonPressed}
  325.  
  326. (******************************************************************************
  327. *                               setMouseCursor                                *
  328. ******************************************************************************)
  329. procedure setMouseCursor(x,y : word);
  330.  
  331. begin
  332.     with reg do begin
  333.         ax := 4;
  334.         cx := x;
  335.         dx := y; {prepare parameters}
  336.         callMouse;
  337.     end; {with}
  338. end; {setMouseCursor}
  339.  
  340. (******************************************************************************
  341. *                                 lastXPress                                  *
  342. ******************************************************************************)
  343. function lastXPress(Button : Byte) : word;
  344.  
  345. begin
  346.     reg.ax := 5;
  347.     reg.bx := Button;
  348.     callMouse;
  349.     lastXPress := reg.cx;
  350. end; {lastXpress}
  351.  
  352. (******************************************************************************
  353. *                                 lastYPress                                  *
  354. ******************************************************************************)
  355. function lastYPress(Button : Byte) : word;
  356.  
  357. begin
  358.     reg.ax := 5;
  359.     reg.bx := Button;
  360.     callMouse;
  361.     lastYPress := reg.dx;
  362. end; {lastYpress}
  363.  
  364. (******************************************************************************
  365. *                                buttonPresses                                *
  366. ******************************************************************************)
  367. function buttonPresses(Button : Byte) : word; {from last check}
  368.  
  369. begin
  370.     reg.ax := 5;
  371.     reg.bx := Button;
  372.     callMouse;
  373.     buttonPresses := reg.bx;
  374. end; {buttonPresses}
  375.  
  376. (******************************************************************************
  377. *                                lastXRelease                                 *
  378. ******************************************************************************)
  379. function lastXRelease(Button : Byte) : word;
  380.  
  381. begin
  382.     reg.ax := 6;
  383.     reg.bx := Button;
  384.     callMouse;
  385.     lastXRelease := reg.cx;
  386. end; {lastXRelease}
  387.  
  388. (******************************************************************************
  389. *                                lastYRelease                                 *
  390. ******************************************************************************)
  391. function lastYRelease(Button : Byte) : word;
  392.  
  393. begin
  394.     reg.ax := 6;
  395.     reg.bx := Button;
  396.     callMouse;
  397.     lastYRelease := reg.dx;
  398. end; {lastYRelease}
  399.  
  400. (******************************************************************************
  401. *                               buttonReleases                                *
  402. ******************************************************************************)
  403. function buttonReleases(Button : Byte) : word; {from last check}
  404.  
  405. begin
  406.     reg.ax := 6;
  407.     reg.bx := Button;
  408.     callMouse;
  409.     buttonReleases := reg.bx;
  410. end; {buttonReleases}
  411.  
  412. (******************************************************************************
  413. *                                    swap                                     *
  414. ******************************************************************************)
  415. procedure swap(var a,b : word);
  416.  
  417. var c : word;
  418.  
  419. begin
  420.     c := a;
  421.     a := b;
  422.     b := c; {swap a and b}
  423. end; {swap}
  424.  
  425. (******************************************************************************
  426. *                                  mouseBox                                   *
  427. ******************************************************************************)
  428. procedure mouseBox(left,top,right,bottom : word);
  429.  
  430. begin
  431.     if (left > right) then swap(left,right);
  432.     if (top > bottom) then swap(top,bottom); {make sure they are ordered}
  433.     reg.ax := 7;
  434.     reg.cx := left;
  435.     reg.dx := right;
  436.     callMouse; {set x range}
  437.     reg.ax := 8;
  438.     reg.cx := top;
  439.     reg.dx := bottom;
  440.     callMouse; {set y range}
  441. end; {mouseBox}
  442.  
  443. (******************************************************************************
  444. *                             graphicMouseCursor                              *
  445. ******************************************************************************)
  446. procedure graphicMouseCursor(xHotPoint,yHotPoint : byte; dataOfs : pointer);
  447.  
  448. {define 16*16 cursor mask and screen mask, pointed by data,
  449.     dataOfs is pointer to data of the masks.}
  450.  
  451. begin
  452.     reg.ax := 9;
  453.     reg.bx := xHotPoint;
  454.     reg.cx := yHotPoint;
  455.     reg.dx := ofs(dataOfs^);    {DS:DX point to masks}
  456.     reg.es := seg(dataOfs^);
  457.     callMouse;
  458.     lastCursor.xH := xHotPoint;
  459.     lastCursor.yH := yHotPoint;
  460.     lastCursor.data := dataOfs;
  461.     {save it in lastCursor, if someone needs to change cursor temporary}
  462. end; {graphicMouseCursor}
  463.  
  464. (******************************************************************************
  465. *                             HardwareTextCursor                              *
  466. ******************************************************************************)
  467. procedure HardwareTextCursor(fromLine,toLine : byte);
  468.  
  469. {set text cursor to text, using the scan lines from..to,
  470.     same as intr 10 cursor set in bios :
  471.     color scan lines 0..7, monochrome 0..13 }
  472.  
  473. begin
  474.     reg.ax := 10;
  475.     reg.bx := 1; {hardware text}
  476.     reg.cx := fromLine;
  477.     reg.dx := toLine;
  478.     callMouse;
  479. end; {hardwareTextCursor}
  480.  
  481. (******************************************************************************
  482. *                             softwareTextCursor                              *
  483. ******************************************************************************)
  484. procedure softwareTextCursor(screenMask,cursorMask : word);
  485.  
  486. { when in this mode the cursor will be achived by ANDing the screen word
  487.     with the screen mask (Attr,Char in high,low order) and
  488.     XORing the cursor mask, ussually used by putting the screen attr
  489.     we want preserved in screen mask (and 0 into screen mask character
  490.     byte), and character + attributes we want to set into cursor mask}
  491.  
  492. begin
  493.     reg.ax := 10;
  494.     reg.bx := 0;    {software cursor}
  495.     reg.cx := screenMask;
  496.     reg.dx := cursorMask;
  497.     callMouse;
  498. end; {softwareMouseCursor}
  499.  
  500. (******************************************************************************
  501. *                               recentXmovement                               *
  502. ******************************************************************************)
  503. function recentXmovement : direction;
  504.  
  505. {from recent call to which direction did we move ?}
  506.  
  507. var d : integer;
  508.  
  509. begin
  510.     reg.ax := 11;
  511.     callMouse;
  512.     d := reg.cx;
  513.     if (d > 0)
  514.         then recentXmovement := moveRight
  515.     else if (d < 0)
  516.         then recentXmovement := moveLeft
  517.     else recentXmovement := noMove;
  518. end; {recentXmovement}
  519.  
  520. (******************************************************************************
  521. *                               recentYmovement                               *
  522. ******************************************************************************)
  523. function recentYmovement : direction;
  524.  
  525. {from recent call to which direction did we move ?}
  526.  
  527. var 
  528.    d : integer;
  529. begin
  530.     reg.ax := 11;
  531.     callMouse;
  532.     d := reg.dx;
  533.     if (d > 0)
  534.         then recentYmovement := moveDown
  535.     else if (d < 0)
  536.         then recentYmovement := moveUp
  537.     else recentYmovement := noMove;
  538. end; {recentYmovement}
  539.  
  540. (******************************************************************************
  541. *                               setWatchCursor                                *
  542. ******************************************************************************)
  543. procedure setWatchCursor;
  544. begin
  545.     graphicMouseCursor(0,0,@watchData);
  546. end; {setWatchCursor}
  547.  
  548. (******************************************************************************
  549. *                              setNewWatchCursor                              *
  550. ******************************************************************************)
  551. procedure setNewWatchCursor; 
  552. begin
  553.    graphicMouseCursor(0, 0, @newWatchCursor);
  554. end; {setNewWatchCursor}
  555.  
  556. (******************************************************************************
  557. *                              setUpArrowCursor                               *
  558. ******************************************************************************)
  559. procedure setUpArrowCursor;
  560. begin
  561.     graphicMouseCursor(5, 0, @upArrowCursor);
  562. end; {setUpArrowCursor}
  563.  
  564. (******************************************************************************
  565. *                             setLeftArrowCursor                              *
  566. ******************************************************************************)
  567. procedure setLeftArrowCursor;
  568. begin
  569.     graphicMouseCursor(0, 3, @leftArrowCursor);
  570. end; {setLeftArrowCursor}
  571.  
  572. (******************************************************************************
  573. *                             setCheckMarkCursor                              *
  574. ******************************************************************************)
  575. procedure setCheckMarkCursor;
  576. begin
  577.     graphicMouseCursor(6, 7, @checkMarkCursor);
  578. end; {setCheckMarkCursor}
  579.  
  580. (******************************************************************************
  581. *                            setPointingHandCursor                            *
  582. ******************************************************************************)
  583. procedure setPointingHandCursor;
  584. begin
  585.     graphicMouseCursor(5, 0, @pointingHandCursor);
  586. end; {setPointingHandCursor}
  587.  
  588. (******************************************************************************
  589. *                           setDiagonalCrossCursor                            *
  590. ******************************************************************************)
  591. procedure setDiagonalCrossCursor;
  592. begin
  593.     graphicMouseCursor(7, 4, @diagonalCrossCursor);
  594. end; {setDiagonalCrossCursor}
  595.  
  596. (******************************************************************************
  597. *                          setRectangularCrossCursor                          *
  598. ******************************************************************************)
  599. procedure setRectangularCrossCursor;
  600. begin
  601.     graphicMouseCursor(7, 4, @rectangularCrossCursor);
  602. end; {setRectangularCrossCursor}
  603.  
  604. (******************************************************************************
  605. *                             setHourGlassCursor                              *
  606. ******************************************************************************)
  607. procedure setHourGlassCursor;
  608. begin
  609.     graphicMouseCursor(7, 7, @hourGlassCursor);
  610. end; {setHourGlassCursor}
  611.  
  612. (******************************************************************************
  613. *                               setArrowCursor                                *
  614. ******************************************************************************)
  615. procedure setArrowCursor;
  616. begin
  617.     graphicMouseCursor(1,1,@arrowData);
  618. end; {setArrowCursor}
  619.  
  620. (******************************************************************************
  621. *                               setEventHandler                               *
  622. ******************************************************************************)
  623. procedure setEventHandler(mask : word; handler    : pointer);
  624.  
  625. {handler must be a far interrupt routine }
  626.  
  627. begin
  628.     reg.ax := 12; {set event handler function in mouse driver}
  629.     reg.cx := mask;
  630.     reg.es := seg(handler^);
  631.     reg.dx := ofs(handler^);
  632.     callMouse;
  633.     lastMask := mask;
  634.     lastHandler := handler;
  635. end; {set event Handler}
  636.  
  637. (******************************************************************************
  638. *                               defaultHandler                                *
  639. ******************************************************************************)
  640. {$F+} procedure defaultHandler; assembler; {$F-}
  641. asm
  642.    push ds; { save TP mouse driver }
  643.    mov ax, SEG @data;
  644.    mov ds, ax; { ds = TP:ds, not the driver's ds }
  645.    mov eventX, cx; { where in the x region did it occur }
  646.    mov eventY, dx;
  647.    mov eventButtons, bx;
  648.    mov eventHappened, 1; { eventHapppened := true }
  649.    pop ds; { restore driver's ds }
  650.    ret;
  651. end;
  652.  
  653. {   this is the default event handler , it simulates :
  654.  
  655.       begin
  656.            eventX := cx;
  657.            eventY := dx;
  658.            eventButtons := bx;
  659.            eventhappened := True;
  660.       end;
  661.  
  662. }
  663.  
  664. (******************************************************************************
  665. *                                GetLastEvent                                 *
  666. ******************************************************************************)
  667. function GetLastEvent(var x,y : word;
  668.     var left_button,right_button,middle_button : buttonState) : boolean;
  669.  
  670. begin
  671.     getLastEvent := eventhappened; {indicate if any event happened}
  672.     eventhappened := False; {clear to next read/event}
  673.     x := eventX;
  674.     y := eventY;
  675.     if ((eventButtons and LEFTBUTTON) <> 0) then
  676.         left_button := buttonDown
  677.     else left_button := buttonUp;
  678.     if ((eventButtons and RIGHTBUTTON) <> 0) then
  679.         right_button := buttonDown
  680.     else right_button := buttonUp;
  681.     if ((eventButtons and MIDDLEBUTTON) <> 0) then
  682.         middle_button := buttonDown
  683.     else middle_button := buttonUp;
  684. end; {getLastEvent}
  685.  
  686. (******************************************************************************
  687. *                              setDefaultHandler                              *
  688. ******************************************************************************)
  689. procedure setDefaultHandler;
  690.  
  691. {get only event mask, and set event handler to defaultHandler}
  692.  
  693. begin
  694.     setEventHandler(mask,@defaultHandler);
  695. end; {setDefaultHandler}
  696.  
  697. (******************************************************************************
  698. *                           enableLightPenEmulation                           *
  699. ******************************************************************************)
  700. procedure enableLightPenEmulation;
  701.  
  702. begin
  703.     reg.ax := 13;
  704.     callMouse;
  705. end; {enableLightPenEmulation}
  706.  
  707. (******************************************************************************
  708. *                          disableLightPenEmulation                           *
  709. ******************************************************************************)
  710. procedure disableLightPenEmulation;
  711.  
  712. begin
  713.     reg.ax := 14;
  714.     callMouse;
  715. end;  {disableLightPenEmulation}
  716.  
  717. (******************************************************************************
  718. *                              defineSensetivity                              *
  719. ******************************************************************************)
  720. procedure defineSensetivity(x,y : word);
  721.  
  722. begin
  723.     reg.ax := 15;
  724.     reg.cx := x; {# of mouse motions to horizontal 8 pixels}
  725.     reg.dx := y; {# of mouse motions to vertical 8 pixels}
  726.     callMouse;
  727.     XMotions := x;
  728.     YMotions := y; {update global unit variables}
  729. end; {defineSensetivity}
  730.  
  731. (******************************************************************************
  732. *                              setHideCursorBox                               *
  733. ******************************************************************************)
  734. procedure setHideCursorBox(left,top,right,bottom : word);
  735.  
  736. begin
  737.     reg.ax := 16;
  738.     reg.es := seg(HideBox);
  739.     reg.dx := ofs(HideBox);
  740.     HideBox.left := left;
  741.     HideBox.right := right;
  742.     HideBox.top := top;
  743.     HideBox.bottom := bottom;
  744.     callMouse;
  745. end; {setHideCursorBox}
  746.  
  747. (******************************************************************************
  748. *                         defineDoubleSpeedTreshHold                          *
  749. ******************************************************************************)
  750. procedure defineDoubleSpeedTreshHold(treshHold : word);
  751.  
  752. begin
  753.     reg.ax := 17;
  754.     reg.dx := treshHold;
  755.     callMouse;
  756. end; {defineDoubleSpeedTreshHold - from what speed to double mouse movement}
  757.  
  758. (******************************************************************************
  759. *                              disableTreshHold                               *
  760. ******************************************************************************)
  761. procedure disableTreshHold;
  762.  
  763. begin
  764.     defineDoubleSpeedTreshHold($7FFF);
  765. end; {disableTreshHold}
  766.  
  767. (******************************************************************************
  768. *                              defaultTreshHold                               *
  769. ******************************************************************************)
  770. procedure defaultTreshHold;
  771.  
  772. begin
  773.     defineDoubleSpeedTreshHold(64);
  774. end; {defaultTreshHold}
  775.  
  776. (******************************************************************************
  777. *                                setMouseGraph                                *
  778. ******************************************************************************)
  779. procedure setMouseGraph;
  780.  
  781. begin
  782.     mouseGraph := True;
  783. end; {setMouseGraph}
  784.  
  785. (******************************************************************************
  786. *                               resetMouseGraph                               *
  787. ******************************************************************************)
  788. procedure resetMouseGraph;
  789.  
  790. begin
  791.     mouseGraph := False;
  792. end; {resetMouseGraph}
  793.  
  794.  
  795. (******************************************************************************
  796. *                               waitForRelease                                *
  797. * Wait until button is release, or timeOut 1/100 seconds pass. (might miss a  *
  798. * tenth (1/10) of a second.                                                                 *
  799. ******************************************************************************)
  800. procedure waitForRelease;
  801. var
  802.     sHour, sMinute, sSecond, sSec100 : word;    { Time at start }
  803.     cHour, cMinute, cSecond, cSec100 : word;    { Current time    }
  804.     stopSec                 : longInt;
  805.     currentSec              : longInt;
  806.     Delta                 : longInt;
  807. begin
  808.     getTime(sHour, sMinute, sSecond, sSec100);
  809.     stopSec := (sHour*36000 + sMinute*600 + sSecond*10 + sSec100 + timeOut) mod
  810.                 (24*360000);
  811.     repeat
  812.        getTime(cHour, cMinute, cSecond, cSec100);
  813.        currentSec := (cHour*36000 + cMinute*600 + cSecond*10 + cSec100);
  814.        Delta := currentSec - stopSec;
  815.     until (not ButtonPressed) or (Delta >=0) and (Delta < 36000);
  816. end; {waitForRelease}
  817.  
  818. (******************************************************************************
  819. *                              swapEventHandler                               *
  820. * handler is a far routine.                                                   *
  821. ******************************************************************************)
  822. procedure swapEventHandler;
  823. begin
  824.    reg.ax := $14;
  825.    reg.cx := mask;
  826.     reg.es := seg(handler^);
  827.     reg.dx := ofs(handler^);
  828.     callMouse;
  829.    lastMask := reg.cx;
  830.    lastHandler := ptr(reg.es,reg.dx);
  831. end; {swapEventHandler}
  832.  
  833. (******************************************************************************
  834. *                            getMouseSaveStateSize                            *
  835. ******************************************************************************)
  836. function getMouseSaveStateSize;
  837. begin
  838.    reg.ax := $15;
  839.    callMouse;
  840.    getMouseSaveStateSize := reg.bx;
  841. end; {getMouseSaveStateSize}
  842.  
  843. (******************************************************************************
  844. *                               interceptMouse                                *
  845. ******************************************************************************)
  846. procedure interceptMouse;
  847. begin
  848.    with reg do begin
  849.       ax := 3;
  850.       callMouse; { get place .. }
  851.       interceptX := cx;
  852.       interceptY := dx;
  853.       ax := 31;
  854.       callMouse;
  855.    end; { disable mouse driver .. }
  856. end; {interceptMouse}
  857.  
  858. (******************************************************************************
  859. *                                restoreMouse                                 *
  860. ******************************************************************************)
  861. procedure restoreMouse;
  862. begin
  863.    with reg do begin
  864.       ax := 32; { restore mouse driver .. }
  865.       callMouse;
  866.       ax := 4;
  867.       cx := interceptX;
  868.       dx := interceptY;
  869.       callMouse;
  870.    end; { with .. }
  871. end; {restoreMouse}
  872.  
  873. var
  874.     OldExitProc : pointer;
  875.  
  876. (******************************************************************************
  877. *                                 MyExitProc                                  *
  878. ******************************************************************************)
  879. {$f+}procedure MyExitProc;
  880. begin
  881.     ExitProc := OldExitProc;
  882.     resetMouseGraph;
  883.     initMouse;
  884. end; { myExitProc }
  885.  
  886. { if this unit is used with a graphic unit that is loaded and executed after
  887.      this unit in the Uses clause, the mouse initialization will not be
  888.      correct, be sure to call initMouse in your program start to work
  889.      properly }
  890.  
  891. begin    {unit initialization}
  892.    eventX := 0;
  893.    eventY := 0;
  894.    eventHappened := false; { initialize ... }
  895.     initMouse; {detect in global variables}
  896.     setArrowCursor; {start like that in graphic mode}
  897.     OldExitProc := ExitProc;
  898.     ExitProc    := @MyExitProc;
  899. end. {mouseLib}
  900.